home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / amiga / amigaker.arc / 09.loading < prev    next >
Text File  |  1987-12-30  |  4KB  |  115 lines
  1. ;
  2. ; 09.loading
  3. ;
  4. ;  File loading.
  5.  
  6. ; Loading a file requires, besides a fib, an input buffer. These buffers
  7. ; hold the line to be loaded, and must be unique if nested loading is used.
  8. ; The buffers are created and kept in a single linked list last in first out
  9. ; The variable lb points to the top.
  10.  
  11. * newlb           (s --  ) Get a load buffer, 256 bytes long, links it into
  12. ; the linked list pointed to by lb, aborts if out of memory.
  13.                   dc.w     -1
  14.                   dc.l     doslink2
  15. doslink2          set      *-4
  16.                   dc.b     $85,'newl',$80!'b'
  17.                   cnop     0,2
  18. _newlb            dc.l     nest
  19.                   dc.l     _2,_nest_lit,256,_AllocMem
  20.                   dc.l     _dup,_0_equal,_nest_abort_quote
  21.                   dc.b     30,'Unable to allocate loadbuffer',0
  22.                   cnop     0,2
  23.                   dc.l     _lb,_fetch,_over,_store,_lb,_store
  24.                   dc.l     _exit
  25.  
  26. * droplb          (s -- )  Unlink top load buffer from the list and
  27. ; discard it.
  28.                   dc.w     -1
  29.                   dc.l     doslink0
  30. doslink0          set      *-4
  31.                   dc.b     $86,'dropl',$80!'b'
  32.                   cnop     0,2
  33. _droplb           dc.l     nest
  34.                   dc.l     _lb,_fetch,_question_dup,_question_branch,1$
  35.                   dc.l     _dup,_fetch,_lb,_store
  36.                   dc.l     _nest_lit,256,_FreeMem
  37. 1$                dc.l     _exit
  38.  
  39.  
  40. * getline         (s addr len -- addr 'len ) Same as gets, but substitutes
  41. ; blanks for cr's. Ignores lines consisting of only a cr. Note that each
  42. ; line is expected to be terminated by a cr.
  43.                   dc.w     -1
  44.                   dc.l     doslink3
  45. doslink3          set      *-4
  46.                   dc.b     $87,'getlin',$80!'e'
  47.                   cnop     0,2
  48. _getline          dc.l     nest
  49.                   dc.l     _2dup
  50. 1$                dc.l     _2drop,_2dup,_gets
  51.                   dc.l     _dup,_1,_not_equals,_question_branch,1$
  52.                   dc.l     _2swap,_2drop
  53.                   dc.l     _dup,_question_branch,3$
  54.                   dc.l     _2dup,_plus,_1_minus,_dup,_c_fetch
  55.                   dc.l     _nest_lit,10,_equals,_question_branch,2$
  56.                   dc.l     _bl,_swap,_c_store,_branch,3$
  57. 2$                dc.l     _drop
  58. 3$                dc.l     _exit
  59.  
  60.  
  61. * #loadline       A variable, 250 by default, but can be set to e.g. 64
  62. ; to load files consisting of blocks.
  63.                   dc.w     -1
  64.                   dc.l     doslink3
  65. doslink3          set      *-4
  66.                   dc.b     $89,'#loadlin',$80!'e'
  67.                   cnop     0,2
  68. _number_loadline  dc.l     docreate,250
  69.  
  70.  
  71. * question        (s -- n )  Works the same as query, but loads from a file
  72. ; n will be zero if end of file is reached.
  73.                   dc.w     -1
  74.                   dc.l     doslink1
  75. doslink1          set      *-4
  76.                   dc.b     $88,'questio',$80!'n'
  77.                   cnop     0,2
  78. _question         dc.l     nest
  79.                   dc.l     _lb,_fetch,_4_plus,_1_plus
  80.                   dc.l     _number_loadline,_fetch
  81.                   dc.l     _getline,_tuck,_swap,_1_minus,_c_store
  82.                   dc.l     _to_in,_off,_exit
  83.  
  84.  
  85. * (load)          (s fib -- ) Loads the file at fib, all input is taken from
  86. ; the file until an end of file is found, nesting is possible.
  87.                   dc.w     0
  88.                   dc.l     link0
  89. link0             set      *-4
  90.                   dc.b     $86,$28,'load',$80!$29
  91.                   cnop     0,2
  92. _nest_load        dc.l     nest
  93.                   dc.l     _question_define
  94.                   dc.l     _dup,_file_open
  95.                   dc.l     _newlb
  96.                   dc.l     _1,_loading,_plus_store
  97.                   dc.l     _in_file,_to_r,_tick_in_file,_store
  98.                   dc.l     _to_in,_fetch,_to_r
  99. 1$                dc.l     _question,_question_branch,2$
  100.                   dc.l     _run,_branch,1$
  101. 2$                dc.l     _r_from,_to_in,_store
  102.                   dc.l     _in_file,_file_close,_r_from,_tick_in_file,_store
  103.                   dc.l     _minus_1,_loading,_plus_store,_droplb,_exit
  104.  
  105.  
  106. * load            Load is deferred word, usually set to (load).
  107.                   dc.w     0
  108.                   dc.l     link0
  109. link0             set      *-4
  110.                   dc.b     $84,'loa',$80!'d'
  111.                   cnop     0,2
  112. _load             dc.l     dodefer,_nest_load
  113.  
  114.  
  115.